Delphi Developer's Kit 1996/Delphi Developer's Kit 1996.iso/power/inmemory/temptbl.pas

Pascal/Delphi Source File | 1995-12-22 | 6KB | 189 lines

{

 This is an TempTable example. Free for anyone to use, modify and do
 whatever else you wish.

 TempTables are supposedly also in-memory tables and provide all of the
 functionality of regular tables. The problem with these is that in DB.PAS
 there is a line in TDataSet.InternalOpen that sets CanModify to False if
 the table is temporary. Why - I don't know, but if you have the VCL source
 (which I highly recommend if you're serious about Delphi programming) then
 you can just comment that part out. Otherwise - this unit is useless to you :(

 Just like all things free it comes with no guarantees. I cannot be responsible
 for any damage this code may cause.

 Thanks to Steve Garland <[e-mail]> for his help. He
 created his own variation of an in-memory table component and I used it
 to get started.

 If you have comments - please contact me at INTERNET:[e-mail]

 Happy hacking!

 Gregory Trubetskoy

}

unit Temptbl;

interface

uses DBTables, WinTypes, WinProcs, DBITypes, DBIProcs, DB, SysUtils;


type TTempTable = class(TTable)
  private
    hCursor: hDBICur;
    procedure EncodeFieldDesc(var FieldDesc: FLDDesc;
      const Name: string; DataType: TFieldType; Size: Word);
    function CreateHandle: HDBICur; override;
    procedure EncodeIndexDesc(var IndexDesc: IDXDesc;
      const Name, Fields: string; Options: TIndexOptions);
  public
    procedure CreateTable;
  end;

implementation

function TTempTable.CreateHandle;
begin
  Result := hCursor;
end;

procedure TTempTable.EncodeIndexDesc(var IndexDesc: IDXDesc;
  const Name, Fields: string; Options: TIndexOptions);
var
  Pos: Integer;
begin
  FillChar(IndexDesc, SizeOf(IndexDesc), 0);
  with IndexDesc do
  begin
  {  if IsDBaseTable then
      AnsiToNative(DBLocale, Name, szTagName, SizeOf(szTagName) - 1)
    else
      AnsiToNative(DBLocale, Name, szName, SizeOf(szName) - 1);   }
    bPrimary := ixPrimary in Options;
    bUnique := ixUnique in Options;
    bDescending := ixDescending in Options;
    bMaintained := True;
    bCaseInsensitive := ixCaseInsensitive in Options;
    if ixExpression in Options then
    begin
      bExpIdx := True;
      AnsiToNative(DBLocale, Fields, szKeyExp, SizeOf(szKeyExp) - 1);
    end else
    begin
      Pos := 1;
      while (Pos <= Length(Fields)) and (iFldsInKey < 16) do
      begin
        aiKeyFld[iFldsInKey] :=
          FieldDefs.Find(ExtractFieldName(Fields, Pos)).FieldNo;
        Inc(iFldsInKey);
      end;
    end;
  end;
end;


procedure TTempTable.EncodeFieldDesc(var FieldDesc: FLDDesc;
  const Name: string; DataType: TFieldType; Size: Word);
const
  TypeMap: array[TFieldType] of Byte = (
    fldUNKNOWN, fldZSTRING, fldINT16, fldINT32, fldUINT16, fldBOOL,
    fldFLOAT, fldFLOAT, fldBCD, fldDATE, fldTIME, fldTIMESTAMP, fldBYTES,
    fldVARBYTES, fldBLOB, fldBLOB, fldBLOB);
begin
  with FieldDesc do
  begin
    AnsiToNative(Locale, Name, szName, SizeOf(szName) - 1);
    iFldType := TypeMap[DataType];
    case DataType of
      ftString, ftBytes, ftVarBytes, ftBlob, ftMemo, ftGraphic:
        iUnits1 := Size;
      ftBCD:
        begin
          iUnits1 := 32;
          iUnits2 := Size;
        end;
    end;
    case DataType of
      ftCurrency:
        iSubType := fldstMONEY;
      ftBlob:
        iSubType := fldstBINARY;
      ftMemo:
        iSubType := fldstMEMO;
      ftGraphic:
        iSubType := fldstGRAPHIC;
    end;
  end;
end;

procedure TTempTable.CreateTable;
var
  I, J: Integer;
  FieldDescs: PFLDDesc;
  ValCheckPtr: PVCHKDesc;
  DriverTypeName: DBINAME;
  TableDesc: CRTblDesc;
begin
  CheckInactive;
  if FieldDefs.Count = 0 then
    for I := 0 to FieldCount - 1 do
      with Fields[I] do
        if not Calculated then
          FieldDefs.Add(FieldName, DataType, Size, Required);
  FieldDescs := nil;
  FillChar(TableDesc, SizeOf(TableDesc), 0);
  with TableDesc do
  begin
    SetDBFlag(dbfTable, True);
    try
      AnsiToNative(Locale, TableName, szTblName, SizeOf(szTblName) - 1);
      {if GetTableTypeName <> nil then
        StrCopy(szTblType, GetTableTypeName);}
      iFldCount := FieldDefs.Count;
      FieldDescs := AllocMem(iFldCount * SizeOf(FLDDesc));
      for I := 0 to FieldDefs.Count - 1 do
        with FieldDefs[I] do
        begin
          EncodeFieldDesc(PFieldDescList(FieldDescs)^[I], Name,
            DataType, Size);
          if Required then Inc(iValChkCount);
        end;
      pFldDesc := AllocMem(iFldCount * SizeOf(FLDDesc));
      Check(DbiTranslateRecordStructure(nil, iFldCount, FieldDescs,
        nil, nil, pFLDDesc));
      iIdxCount := IndexDefs.Count;
      pIdxDesc := AllocMem(iIdxCount * SizeOf(IDXDesc));
      for I := 0 to IndexDefs.Count - 1 do
        with IndexDefs[I] do
          EncodeIndexDesc(PIndexDescList(pIdxDesc)^[I], Name, Fields,
            Options);
      if iValChkCount <> 0 then
      begin
        pVChkDesc := AllocMem(iValChkCount * SizeOf(VCHKDesc));
        ValCheckPtr := pVChkDesc;
        for I := 0 to FieldDefs.Count - 1 do
          if FieldDefs[I].Required then
          begin
            ValCheckPtr^.iFldNum := I + 1;
            ValCheckPtr^.bRequired := True;
            Inc(ValCheckPtr);
          end;
      end;
      Check(DbiCreateTempTable(DBHandle, TableDesc, hCursor));
      Check(DbiSetProp(hDBIObj(hCursor), curXLTMODE, LongInt(xltFIELD)));
    finally
      if pVChkDesc <> nil then FreeMem(pVChkDesc, iValChkCount * SizeOf(VCHKDesc));
      if pIdxDesc <> nil then FreeMem(pIdxDesc, iIdxCount * SizeOf(IDXDesc));
      if pFldDesc <> nil then FreeMem(pFldDesc, iFldCount * SizeOf(FLDDesc));
      if FieldDescs <> nil then FreeMem(FieldDescs, iFldCount * SizeOf(FLDDesc));
      SetDBFlag(dbfTable, False);
    end;
  end;
end;

end.